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-- file DIActionsMed.Mesa 
-- Edited by: 

Sandman, April 17, 1978 4:41 PM 

Barbara, July 31, 1978 5:13 PM 
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DIRECTORY 

AltoDefs: FROM "altodefs" USING [wordlength] , 
CommandDefs: FROM "commanddef s" USING [WriteErrorString] , 
ControlDefs: FROM ''control def s" USING [ 

FieldDescriptor , FrameHandle, GFT, GFTItem, Global FrameHandle, 

MaxParmsInStack, ProcDesc, StateVector] , 
DebugData: FROM "debugdata" USING [worryentry], 
DebuggerDefs: FROM "debuggerdef s" USING [ 

GetValue, GetValueN, InitSOP, LA, SA, SOPointer, SymbolObject] , 
DebugMiscDefs: FROM "debugmiscdef s" USING [DebugAbort] , 
DebugUtilityDefs: FROM "debugutil itydef s" USING [ 

CheckFrame, LengthenPointer , LongREAD, LongWRITE, MREAD, 

MWRITE, ReadGlobalGFI, UserCall, Val idGlobal Frame] , 
DIActionDefs: FROM "diactiondef s" USING [ 

AllocateHereStackltem, AllocateThereStackltem, dereferenceltem, espTosop, 

FreeStackltem, GetCurrentST , IncorrectType, popeval stack, popNeval stack, 

pushevalstack, Transfer, TypesDontMatch] , 
DIDefs: FROM "didefs" USING [ESPointer, hereESPointer , thereESPointer] , 
DITypeDefs: FROM "ditypedefs" USING [ 

AssignableTypes , ESPointer, SeiPType, TypeArray, TypeArrayDesc, 

Typelnteger, TypePointer, TypeProcedure, TypeString], 
InlineDefs: FROM " inl inedef s" USING [COPY], 
Mopcodes: FROM "mopcodes" USING [zRFS, zWFS], 
SDDefs: FROM "sddefs" USING [SD, sGFTLength], 
StringDefs: FROM "stringdef s" USING [Substring], 
SymDefs: FROM "symdefs" USING [ 

CBTIndex, CSEIndex, ISEIndex, recordCSEIndex, SEIndex, SENull], 
SystemDefs: FROM "systemdefs" USING [AllocateHeapNode] ; 

DIActionsMed: PROGRAM 

IMPORTS CommandDefs, DDptr: DebugData, DebuggerDefs, DebugMiscDefs, 

DebugUtilityDefs, DIActionDefs, DITypeDefs, SystemDefs 
EXPORTS DIActionDefs * 
BEGIN 

--stack items 

ESPointer: TYPE = DIDefs .ESPointer ; 
hereESPointer: TYPE = DIDefs .hereESPointer ; 
thereESPointer: TYPE = DIDefs . thereESPointer ; 
SOPointer: TYPE = DebuggerDefs .SOPointer ; 

--assignment statements 
Notlmplemented: PUBLIC SIGNAL = CODE; 

assignvalue: PUBLIC PROCEDURE [rhs: ESPointer, Ins: thereESPointer] = 
BEGIN OPEN DIActionDefs; 
IF -DITypeDefs. AssignableTypes[lhs, rhs] OR 

(DITypeDefs . TypeString[rhs] AND rhs. tag a here) 
THEN SIGNAL TypesDontMatchp hs , rhs]; 
Assign[lhs , rhs]; 
FreeStackItem[rhs] ; 
FreeStackItem[lhs] ; 
RETURN 
END; 

Assign: PROCEDURE [Ins: thereESPointer, right: ESPointer] = 
BEGIN OPEN DebugUtilityDefs; 

rhs: hereESPointer <- DIActionDefs .Transfer[right]; 
i: CARDINAL; 

f d: ControlDefs .FieldDescriptor; 
word: UNSPECIFIED; 
IF rhs .wordlength - 1 THEN 
BEGIN 

WITH rhs . stbase. seb+rhs. stbase.UnderType[rhs . tsei] SELECT FROM 
subrange B > IF origin # THEN rhs. value «- rhs. value + origin; 
ENDCASE; 
WITH "Ins. stbase. seb+lhs. stbase. UnderTypephs. tsei] SELECT FROM 
subrange »> IF origin # THEN rhs. value <- rhs. value - origin; 
ENDCASE; 
END; 
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IF "Ihs.bitsize <= AltoDef s .wordlength THEN 
BEGIN OPEN InlineDefs; 

IF rhs. wordlength > 1 THEN SIGNAL DIActionDef s.TypesDontMatch[lhs , rhs]; 
fd «- [offset: 0, posn: Ihs.bitof f set , size: Ihs.bitsize]; 
WITH Ins SELECT FROM 

short «> word <- MREAD[shortAddr] ; 
long «> word «- LongREAD[longAddr . Ip] ; 
ENDCASE; 
WriteFiel d[rhs .value, ©word, fd]; 
WITH Ins SELECT FROM 

short => MWRITE[shortAddr, word]; 
long ■> LongWRITE[longAddr . Ip, word]; 
ENDCASE; 
END 
ELSE 

BEGIN OPEN DebuggerDefs; 

IF Ihs.bitsize MOD Al toDefs .wordlength # OR Ihs .bitof f set # 

THEN ERROR; 
IF rhs. wordlength = 1 THEN LengthenHESP[lhs , rhs]; 
FOR i IN [0. .Ihs. bitsize/Al toDef s . wordlength) DO 
WITH Ihs SELECT FROM 

short => MWRITE[shortAddr+i , (rhs.ptr+i)t]; 
long a > LongWRITE[longAddr . Ip+i , (rhs ,ptr+i)t] ; 
ENDCASE; 
ENDLOOP; 
END; 
DIActionDefs. FreeStackItem[rhs]; 
RETURN 
END; 

LengthenHESP: PROCEDURE [lesp: thereESPointer , esp: hereESPointer] « 
BEGIN OPEN DebuggerDefs, DITypeDefs; 
la: LA; 
SELECT TRUE FROM 

TypePointer[lesp] => la.lp «- DebugUtil ityDefs .LengthenPointer[esp .value]; 
Typelnteger[lesp] ■> 

BEGIN OPEN e:esp.stbase; 

WITH e.seb + e. UnderType[esp. tsei] SELECT FROM 
subrange -> la.li <- CARDINAL[esp . val ue] ; 
basic ~> la.li «- INTEGER[esp. value]; 
ENDCASE => ERROR; 
END; 
ENDCASE => ERROR; 
esp.ptr <- SystemDef s.AllocateHeapNode[esp. wordlength *- 2]; 
LOOPHOLE[esp.ptr, POINTER TO LA]t 4- la; 
RETURN 
END; 

ReadField: PROCEDURE [POINTER, ControlDef s . Fiel dDescriptor] RETURNS [UNSPECIFIED] 
MACHINE CODE BEGIN Mopcodes . zRFS END; 

WriteField: PROCEDURE [UNSPECIFIED, POINTER, ControlDef s . FieldDescriptor] ■ 
MACHINE CODE BEGIN Mopcodes . zWFS END; 

--expression lists 

GetArrayElement: PROCEDURE [esp: ESPointer] RETURNS [new: ESPointer] * 
BEGIN OPEN DIActionDefs, s: esp.stbase; 
temp: ESPointer; 
isei, csei: SymDef s .SEIndex; 
packed: BOOLEAN; 
i: INTEGER; 
csize: CARDINAL; 
tnew: thereESPointer; 

temp <~ popeval s tack[] ; -- get temp . value( th) element 
WITH s.seb-ts.UnderType[esp. tsei] SELECT FROM 
long «> esp. tsei «- rangetype; 
ENDCASE; 
WITH a: (s.seb+s.UnderType[esp.tsei]) SELECT FROM 
array *> 
BEGIN 

packed «- a. packed; 

csize *- s .WordsForType[s .UnderType[csei <- a.componenttype]]; 
isei ♦- a. indextype; 
END; 
arraydesc »> 

WITH aa: (s. seb+s . UnderType[a. describeclType]) SELECT FROM 
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array ■> 
BEGIN 

packed «- aa. packed; 

csize <- s .WordsForType[s.UnderType[csei «- aa. componenttype]] ; 
isei *- aa. indextype; 
END; 
ENDCASE ■> ERROR; 
ENDCASE «> ERROR; 
i <- GetTheValue[temp]; 

WITH s. seb+s. UnderType[isei] SELECT FROM 
subrange »> i <- i - origin; 
ENDCASE; 
WITH e: esp SELECT FROM 
there => 

BEGIN OPEN DebuggerDefs, DebugUtil ityDefs ; 
wordoffset: CARDINAL » 

IF packed THEN CARDINAL[i]/2 ELSE CARDINAL[i]*csize; 
tnew +- AllocateThereStackItem[] ; 
tnew.stbase <- esp.stbase; 
tnew. tsei <- csei ; 

tnew.bitoffset <- IF packed AND i MOD 2 - 1 THEN 8 ELSE 0; 
tnew.bitsize *- IF packed THEN 8 ELSE 16*csize; 
WITH e SELECT FROM 
short => tnew.addr «- 

short[shortAddr: [WITH a: (s . seb+s .UnderType[tsei]) SELECT FROM 
arraydesc B > MREAD[shortAddr] + wordoffset, 
ENDCASE => shortAddr + wordoffset]]; 
long => WITH a: (s . seb+s .UnderType[tsei]) SELECT FROM 
arraydesc => tnew.addr «- short[ 

shortAddr: [LongREAD[longAddr . Ip] + wordoffset]]; 
ENDCASE => tnew.addr ♦- long[ 

longAddr:LA[LI[longAddr.li + wordoffset]]]; 
ENDCASE; 
new <~ tnew; 
END; 
here => 

WITH a: (s. seb+s. UnderType[e. tsei]) SELECT FROM 
arraydesc «> 
BEGIN 

tnew «- AT locateThereStackItem[] ; 
tnew.stbase *- esp.stbase; 
tnew. tsei «- csei ; 

tnew.bitoffset «- IF packed AND i MOD 2 « 1 THEN 8 ELSE 0; 
tnew.addr «- short[LOOPHOLE[e. ptrt +(IF packed THEN CARDINAL[i]/2 

ELSE CARDINAL[i]*csize), DebuggerDef s .SA]] ; 
tnew.bitsize <- IF packed THEN 8 ELSE 16*csize; 
new *- tnew; 
END; 
ENDCASE => ERROR; -- what about here arrays ?? 
ENDCASE => ERROR; 
FreeStackItem[temp] ; 
FreeS tack I tem[esp] ; 
RETURN 
END; 

--indexing strings 

GetStringElement: PROCEDURE [esp: ESPointer] RETURNS [new: ESPointer] = 
BEGIN OPEN DIActionDefs, s: esp.stbase; 
i: CARDINAL; 
hnew: hereESPointer ; 
tnew: thereESPointer ; 

i <- GetTheValue[popeval stack[]]; -- get i(th) character 
WITH e:esp SELECT FROM 
here => 

BEGIN OPEN ss: LOOPHOLE[e. value, Str ingDefs .Substring] ; 
hnew <- AnocateHereStackItem[]; 
hnew. value «- ss . base[ss .of f set+i] ; 
new «- hnew; 
END; 
there a > 

BEGIN OPEN DebugUtilityDefs; 
tnew <- AllocateThereStackItem[]; 
WITH e SELECT FROM 

short «> tnew.addr <- shor t[shor lAddr : [MREAD[shor tAddr]+2+i/2]] ; 
long *> tnew.addr «- short[shortAddr : [LongREAD[longAddr . lp]+2+i/2]] ; 
ENDCASE; 



DIActionsMed.mesa 2-Sep-78 15:32:14 Page 



tnew.bitsize <- 8; 

tnew.bitoffset <- IF i MOD 2 ■ 1 THEN 8 ELSE 0: 

new <- tnew; 

END; 
ENDCASE «> ERROR; 
new.stbase «- DIActionDef s .GetCurrentST[] ; 

new.tsei <- DITypeDef s.SeiPType[character , DIActionDef s .GetCurrentST[]]; 
FreeStackItem[esp] ; 
RETURN 
END; 

InvalidExpression: PUBLIC SIGNAL ■ CODE; 

--calling procedures 

ProcedureCall : PROCEDURE [esp: ESPointer, nparams: CARDINAL] 
RETURNS [results: hereESPointer] - 
BEGIN OPEN DIActionDefs, s: esp.stbase; 
found: BOOLEAN; 

so: DebuggerDef s .SymbolObject; 
sop: SOPointer «- @so; 
state: ControlDefs .StateVector ; 
procdesc: ControlDefs .ProcDesc; 
param: ESPointer; 
i,n: CARDINAL ♦• 0; 

typein, typeout: SymDef s . recordCSEIndex; 
sei: SymDefs. ISEIndex; 
IF DDptr .worryentry THEN 
BEGIN 

CommandDef s .WriteErrorString[naworry]; 
SIGNAL DebugMiscDefs.DebugAbort; 
END; 
WITH (s.seb+LOOPHOLE[esp.tsei, SymDef s .CSEIndex]) SELECT FROM 
transfer «> 

BEGIN typein «- inrecord; typeout «- outrecord; END; 
ENDCASE => ERROR; 
IF (state. stkptr «- s.WordsForType[typein]) > ControlDefs .MaxParmsInStack 
OR s .WordsForType[typeout] > ControlDefs .MaxParmsInStack 
THEN SIGNAL InvalidExpression; 
IF typein # SymDef s .SENull THEN -- no input params 

FOR sei <- s .Firs tCtxSe[(s . seb+typein) .f ieldctx] , s .NextSe[sei] 
UNTIL sei = SymDefs. SENull DO 

IF nparams a THEN SIGNAL InvalidExpression; 

param <- popNevalstack[nparams-l]; 

IF ~ArgumentType[param, esp t (s .seb+sei) . idtype] 

THEN SIGNAL InvalidExpression 
ELSE BEGIN 

DebuggerDefs. InitSOP[sop]; 
espTosop[param,sop]; 

FOR i IN [0. .param. stbase. WordsForType[param. tsei]) DO 
state. stk[n] <- DebuggerDef s .GetVal ueN[sop, i] ; 
WITH sop. stbase. seb+sop. stbase. UnderType[sop. tsei] SELECT FROM 
subrange ■> 

IF origin # THEN state. stk[n] «- state. stk[n] + origin; 
ENDCASE; 
n ♦■ n+1; 
ENDLOOP; 
END; 
nparams «- nparams - 1; 
FreeStackItem[param]; 
ENDLOOP; 
IF nparams # THEN SIGNAL InvalidExpression; 
DebuggerDefs . InitSOP[sop]; 
espTosop[esp, sop] ; 
[procdesc .found] <- decodeproc[sop] ; 
IF -found THEN SIGNAL Inval idExpression[] ; 
state, dest <- procdesc; 

state. source <- 0; state, instbyte +- 0; state. fill <- 0; --not used 
[] 4- DebugUtilityDefs.UserCall[@state]; 
IF typeout # SymDefs. SENull THEN 
BEGIN 

results <- Al locateHereStackl tem[]; 
results . stbase <- esp.stbase; 
IF (resul ts. stbase. seb+typeout) .unifield THEN 

BEGIN OPEN rs: resul ts . s tbase , r: ( rs . seb»- typeout) ; 
results. tsei ♦- (rs . FirstCtxSe[r .fiel dctx]+rs . seb) . idtype; 
END 
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ELSE results. tsei ♦• typeout; 

results. wordlength «- s.WordsForType[typeout] ; 

IF results. wordlength ■ 1 THEN resul ts. value <- state. stk[0] 

ELSE BEGIN 

results. ptr <- SystemDef s. AllocateHeapNode[resul ts .wordlength]; 

In! ineDef s.C0PY[f rom: ©state. stk[0] , to: results. ptr, nwords: resul ts. wordlength]; 
END; 
END 
ELSE results <- NIL; 
FreeStackItem[esp] ; 
RETURN 
END; 

decodeproc: PROCEDURE [sop: SOPointer] 

RETURNS[pd: ControlDef s .ProcDesc , found: BOOLEAN] - 

BEGIN OPEN DebugUtilityDefs, ControlDefs, SDDefs, sop.stbase; 

f: FrameHandle; 

frame: Global FrameHandle; 

e: CARDINAL; 

gfti: CARDINAL; 

bti: SymDefs.CBTIndex; 

gft: DESCRIPTOR FOR ARRAY OF GFTItem <- 

DESCRIPTOR[GFT, MREAD[SD+sGFTLength]] ; 
WITH sop.baddr SELECT FROM 

short => f <- LOOPHOLE[shortAddr, FrameHandle]; 

ENDCASE => ERROR; 
frame ♦- IF CheckFrame[f ] THEN MREAD[@f . accessl ink] 

ELSE L00PH0LE[f, Gl obal FrameHandl e] ; 
IF (seb+sop. sei) . constant THEN 

BEGIN 

frame *- IF CheckFrame[f ] THEN MREAD[@f . accessl ink] 
ELSE LOOPHOLE[f, GlobalFrameHandle] ; 

bti <- (seb+sop. sei) , idinfo; 

e <- (bb+bti) .entrylndex; 

WITH (bb+bti) SELECT FROM 
Outer -> pd.tag «- procedure; 
ENDCASE -> pd.tag *- unbound; 

gfti +- ReadGlobalGFI[frame]; 

pd.gfi «~ gfti + e/32; 

pd.ep «- e MOD 32; 

END 
ELSE 

BEGIN 

pd <- DebuggerDef s .GetValue[sop]; 

gfti «- pd.gfi ; 

f ♦- MREAD[0gft[gfti]. frame]; 

frame <- MREAD[@f. access! ink]; 

END; 
IF gfti ~ IN[O..LENGTH[gft]) OR MREAD[@gf t[gf ti] .epbase] MOD 32 # OR 

~Val idGlobalFrame[f rame] OR pd.tag # procedure THEN 

RETURN[pd, FALSE]; 
RETURN[pd, TRUE]; 
END; 

ArgumentType: PROCEDURE[param, esp: ESPointer, tsei: SymDef s .SEIndex] 
RETURNS[ok: BOOLEAN] = 
BEGIN OPEN DIActionDefs; 
temp: ESPointer; 

IF DITypeDefs.TypeString[param] AND param.tag = here THEN RETURN[FALSE] ; 
temp <~ Al locateHereStackItem[]; 
temp.stbase <~ esp.stbase; temp. tsei <- tsei; 
ok *- DITypeDefs . AssignableTypes[param, temp]; 
FreeStackItem[temp]; 
END; 

GetRelativePointer: PROCEDURE [esp: ESPointer] RETURNS[tnew: thereESPointer] - 
BEGIN OPEN DIActionDefs; 
rptr: ESPointer; 

rptr <- popevalstack[] ; -- of the form esp[rptr] 

WITH p: (esp. stbase . seb+esp . stbase.UnderType[esp. tsei]) SELECT FROM 
pointer => IF ~p. basing THEN SIGNAL IncorrectType[esp] ; 
ENDCASE «> SIGNAL Incorrec tType[esp] ; 
WITH r : (rptr . stbase. seb+rptr. stbase . UnderType[rptr. tsei]) SELECT FROM 
relative «> 
BEGIN 
hnew: hereESPointer ; 
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hnew <- AllocateHereStackItem[]; 

hnew.stbase «- esp.stbase; 

hnew.tsei «- r.resul tType; 

hnew. value «- GetTheValue[esp] + GetTheValue[rptr] ; 

tnew <- AnocateThereStackItem[]; 

tnew «- dereferenceltem[hnew IANY -> SIGNAL IncorrectType[hnew]] ; 

END; 
ENDCASE => SIGNAL IncorrectType[rptr] ; 
FreeStackItem[esp] ; 
RETURN 
END; 

evaluateExpList: PUBLIC PROCEDURE RETURNS [ESPointer] - 
BEGIN OPEN DIActionDefs, DebugUtil i tyDef s , DITypeDefs; 
size: hereESPointer <- LOOPHOLE[popevalstack[] , hereESPointer]; 
listsize: CARDINAL <- size. value; 
esp: ESPointer ♦- popNevalstack[l istsize] ; 
testesp: ESPointer; 
FreeStackItem[size]; 

IF TypeProcedure[esp] THEN RETURN[ProcedureCall[esp, listsize]]; 
IF listsize # 1 THEN SIGNAL DIActionDefs . IncorrectType[esp] ; 
SELECT TRUE FROM 

TypeString[esp] => RETURN[GetStringElement[esp]]; 
TypePointer[esp] «> 
BEGIN 

WITH p : (esp. stbase . seb+esp . stbase.UnderType[esp. tsei]) SELECT FROM 
pointer => IF p. basing THEN RETURN[GetRel ativePointer[esp]]; 
ENDCASE; 
testesp <- dereferenceltem[esp I ANY => GOTO null]; 
RETURN[IF (TypeArrayDesc[testesp] OR TypeArray[testesp]) 

THEN GetArrayElement[testesp] ELSE GetRelativePointer[testesp]] ; 
EXITS 

null => RETURN[GetRelativePointer[esp]]; 
END; 
(TypeArrayDesc[esp] OR TypeArrayfesp]) => RETURN[GetArrayElement[esp]]; 
ENDCASE => SIGNAL DIActionDefs . IncorrectType[esp] ; 
END; 

GetTheValue: PROCEDURE [esp: ESPointer] RETURNS [value: UNSPECIFIED] - 
BEGIN OPEN DIActionDefs; 
so: DebuggerDef s .SymbolObject; 
sop: SOPointer *- @so; 
WITH esp SELECT FROM 
here => RETURN[value]; 
there => 
BEGIN 

espTosop[esp,sop]; 
RETURN[DebuggerDefs.GetValue[sop]]; 
END; 
ENDCASE *> ERROR; 
END; 

startList: PUBLIC PROCEDURE [size: CARDINAL] RETURNS [new: hereESPointer] ■ 
BEGIN OPEN DIActionDefs; 
new <- AllocateHereStackItem[]; 

new. tsei <- DITypeDefs . SeiPType[ integer , DIActionDefs .GetCurrentST[]]; 
new. value ♦- size; 
RETURN 
END; 

incrementList: PUBLIC PROCEDURE - 
BEGIN OPEN DIActionDefs; 

new: hereESPointer <- LOOPHOLE[popNeval stack[l] , hereESPointer]; 
new. value «- new. value + 1; 
pusheval stack [new] ; 
RETURN 
END; 

END.. 



